perm filename ARITH.MAC[RUT,LSP] blob
sn#343717 filedate 1978-03-22 generic text, type T, neo UTF8
00100 TITLE ARITH - FORTRAN INTERFACE (ONE ARGUMENT FUNCTIONS)
00200 ;
00300 ;
00400 STKSIZ==10 ;TEMPROARY STACK FOR F10 ROUTINES
00500 ;
00600 ENTRY LSQRT,LOG,LOG10,LSIN,LCOS,LACOS,LASIN,LATAN
00700 ENTRY LSINH,LCOSH,LTANH,LEXP,LFLOAT,RANDOM,LSIND,LCOSD
00800 ENTRY FORER.
00900 OPDEF CALL[34B8]
01000 OPDEF JCALL[35B8]
01100 S=11 ;## MAKE THE DAMN THING RELOCATABLE
01200 P=14
01300 A=1
01400 B=2
01500 EXTERN MAKNUM,NUMVAL,FLONUM,SQRT,SIN,COS,ATAN,ACOS,ASIN
01600 EXTERN ALOG,ALOG10,SINH,COSH,TANH,EXP,FLOAT,RAN,SIND,COSD
01700 ;
01800 FORER.: PUSHJ 17,FORPT ;PRINT ERROR MESSAGE
01900 ;
02000 FORPT: PUSH 17,A ;SAVE A REGISTER
02100 MOVE A,-1(17) ;LOAD OLD PC
02200 LDB A,[POINT 4,-1(A),12] ;LOAD AC FIELD
02300 CAIN A,10 ;STRING TO OUTPUT?
02400 SKIPA A,@-1(17) ;LOAD ADDRESS OF STRING
02500 MOVEI A,[ASCIZ /OVERFLOW/]; DEFAULT STRING
02600 OUTSTR [ASCIZ /
02700 ? /]; ;START OF STRING
02800 OUTSTR (A) ;BALANCE
02900 OUTSTR [ASCIZ /
03000 /] ;TERMINAL CR/LF
03100 POP 17,A ;RESTORE REGISTER
03200 AOS (17) ;
03300 POPJ 17, ;RETURN
03400 ;
03500 ;
03600 COMP: HRRM B,JMP
03700 CALL 1,NUMVAL
03800 CAIE B,FLONUM(S)
03900 JRST ,FLT
04000 SFLTE: MOVEM A,AR1
04100 MOVE A,[XWD 0,BLT1 ]
04200 BLT A,BLT1+17
04300 MOVE 17,[IOWD STKSIZ,STKBLK]
04400 JMP: JSA 16,.-.
04500 JUMP 2,AR1
04600 MOVEM 0,AR1
04700 MOVE A,[XWD BLT1,0]
04800 BLT A,17
04900 MOVE A,AR1
05000 MOVEI B,FLONUM(S)
05100 JCALL 2,MAKNUM
05200 LSQRT: MOVEI B,SQRT
05300 JRST ,COMP
05400 LOG: MOVEI B,ALOG
05500 JRST ,COMP
05600 LOG10: MOVEI B,ALOG10
05700 JRST ,COMP
05800 LSIN: MOVEI B,SIN
05900 JRST ,COMP
06000 LCOS: MOVEI B,COS
06100 JRST ,COMP
06200 LSIND: MOVEI B,SIND
06300 JRST ,COMP
06400 LCOSD: MOVEI B,COSD
06500 JRST ,COMP
06600 LACOS: MOVEI B,ACOS
06700 JRST B,COMP
06800 LASIN: MOVEI B,ASIN
06900 JRST ,COMP
07000 LATAN: MOVEI B,ATAN
07100 JRST ,COMP
07200 LSINH: MOVEI B,SINH
07300 JRST ,COMP
07400 LCOSH: MOVEI B,COSH
07500 JRST ,COMP
07600 LTANH: MOVEI B,TANH
07700 JRST ,COMP
07800 LEXP: MOVEI B,EXP
07900 JRST ,COMP
08000 LFLOAT: CALL 1,NUMVAL
08100 CAIN B,FLONUM(S)
08200 JCALL 2,MAKNUM
08300 FLT1: MOVEI B,FLOAT
08400 HRRM B,JMP
08500 JRST ,SFLTE
08600 FLT: HRR B,JMP
08700 HRRM B,AR2
08800 PUSHJ P,FLT1
08900 HRR B,AR2
09000 JRST ,COMP
09100 RANDOM: MOVEI B,RAN
09200 JRST ,FLT1+1
09300 AR2: 0
09400 AR1: 0
09500 BLT1: BLOCK 20
09600 ;
09700 STKBLK: BLOCK STKSIZ
09800 ;
09900 END